home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 10 / AACD 10.iso / AACD / Programming / AmigaTalk / examples / IceCreamStoreSim.st < prev    next >
Text File  |  1998-09-30  |  4KB  |  156 lines
  1. " Simple Minded simulation from Chapter 6 of 'A Little Smalltalk'.
  2.  
  3.   IceCream Store - multiple event queue
  4. "
  5. Class Main
  6. [
  7.   main | i |
  8.     i <- IceCreamStore new.
  9.     [i time < 60] whileTrue: [ i proceed ].
  10.     i reportProfits
  11. ]
  12.  
  13. Class Simulation
  14. | currentTime eventQueue |
  15. [
  16.   new
  17.     eventQueue  <- Dictionary new.
  18.     currentTime <- 0
  19. |
  20.   time
  21.     ^ currentTime
  22. |
  23.   addEvent: event at: eventTime
  24.     (eventQueue includesKey: eventTime)
  25.       ifTrue:  [(eventQueue at: eventTime) add: event]
  26.       ifFalse: [eventQueue  at: eventTime put: (Set new ; add: event)]
  27. |   
  28.   addEvent: event next: timeIncrement
  29.     self addEvent: event at: currentTime + timeIncrement
  30. |
  31.   proceed | minTime eventset event |
  32.     minTime <- 99999.
  33.     eventQueue keysDo: [:x | (x < minTime) ifTrue: [minTime <- x]].
  34.  
  35.     currentTime <- minTime.
  36.     eventset    <- eventQueue at: minTime ifAbsent: [^nil].
  37.     event       <- eventset first.
  38.  
  39.     eventset remove: event.
  40.  
  41.     (eventset isEmpty) ifTrue: [eventQueue removeKey: minTime].
  42.     self processEvent: event
  43. ]
  44.  
  45. Class IceCreamStore :Simulation
  46. | profit arrivalDistribution rand scoopDistribution remainingChairs |
  47. [
  48.   new
  49.     profit          <- 0.
  50.     remainingChairs <- 15.
  51.     rand            <- Random new.
  52.  
  53.     (arrivalDistribution <- Normal new)
  54.     setMean: 3.0 deviation: 1.0.
  55.     (scoopDistribution <- DiscreteProbability new)
  56.     defineWeights: #(65 25 10).
  57.     self scheduleArrival
  58. |
  59.   scheduleArrival | newcustomer time |
  60.     newcustomer <- Customer new.
  61.     time <- self time + (arrivalDistribution next).
  62.     (time < 15) ifTrue: [self addEvent: [self customerArrival: newcustomer]
  63.                               at: time
  64.                         ]
  65. |
  66.   processEvent: event
  67.     ('event received at ', self time printString) print.
  68.     event value.
  69.     self scheduleArrival
  70. |
  71.   customerArrival: customer   | size |
  72.     size <- customer groupSize.
  73.     ('group of size ', size printString , ' arrives') print.
  74.     (size < remainingChairs)
  75.       ifTrue: [remainingChairs <- remainingChairs - size.
  76.                 'take chairs, schedule order' print.
  77.                 self addEvent: [self customerOrder: customer]
  78.                 next: (rand randInteger: 3).
  79.               ]
  80.       ifFalse: ['finds no chairs, leave' print]
  81. |
  82.   customerOrder: customer      | size numScoops |
  83.     size      <- customer groupSize.
  84.     numScoops <- 0.
  85.  
  86.     size timesRepeat: [numScoops <- numScoops + scoopDistribution next].
  87.  
  88.     ('group of size ', size printString, ' orders ' ,
  89.     numScoops printString, ' scoops') print.
  90.  
  91.     profit <- profit + (numScoops * 0.17).
  92.  
  93.     self addEvent: [self customerLeave: customer] 
  94.              next: (rand randInteger: 5)
  95. |
  96.   customerLeave: customer | size |
  97.     size <- customer groupSize.
  98.     ('group of size ', size printString, ' leaves') print.
  99.     remainingChairs <- remainingChairs + customer groupSize
  100. |
  101.   reportProfits
  102.    ('profits are ', profit printString) print
  103. ]
  104.  
  105. Class Customer
  106. | groupSize |
  107. [
  108.   new
  109.     groupSize <- (Random new "randomize") randInteger: 8
  110. |
  111.   groupSize
  112.     ^ groupSize
  113. ]
  114.  
  115. Class DiscreteProbability
  116. | weights rand max |
  117. [
  118.   defineWeights: anArray
  119.     weights <- anArray.
  120.  
  121.     (rand <- Random new) "randomize".
  122.  
  123.     max <- anArray inject: 0 into: [:x :y | x + y]
  124. |
  125.   next   | index value |
  126.     value <- rand randInteger: max.
  127.     index <- 1.
  128.  
  129.     [value > (weights at: index)]
  130.        whileTrue: [value <- value - (weights at: index). 
  131.                             index <- index + 1
  132.                   ].
  133.     ^ index
  134. ]
  135.  
  136. Class Normal :Random
  137. | mean deviation |
  138. [
  139.   new
  140.     self setMean: 1.0 deviation: 0.5
  141. |
  142.   setMean: m deviation: s
  143.     mean      <- m.
  144.     deviation <- s
  145. |
  146.   next | v1 v2 s u |
  147.     s <- 1.
  148.     [s >= 1] whileTrue: [v1 <- (2 * super next) - 1.
  149.                          v2 <- (2 * super next) - 1.
  150.                           s <- v1 squared + v2 squared
  151.                         ].
  152.  
  153.     u <- (-2.0 * s ln / s) sqrt.
  154.     ^ mean + (deviation * v1 * u)
  155. ]
  156.